home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0265 / define.bas (.txt) next >
Encoding:
GW-BASIC  |  1983-09-13  |  5.0 KB  |  94 lines
  1. 10  REM DSNAME=DEFINE.BAS
  2. 20  GOTO 40
  3. 30  GOSUB 50135:PUT(200,80),FI%:GOTO 250 'LINK IF LOADED DATA
  4. 40  REM ORIGINALLY WRITTEN 03/18/82 THIS PROGRAM ALLOWS YOU TO DEFINE SPECIAL CHARACTERS AND SUCH.
  5. 50  REM THIS VERSION COMPLETED ON 6/20/82.  FOR COMMENTS AND SUGGESTIONS,
  6. 60  REM PLEASE CONTACT BRUCE GUTHRIE BY MAIL AT
  7. 70  REM    P.O. BOX 710
  8. 80  REM    WASHINGTON, D.C. 20044
  9. 90  REM Copyright Bruce Guthrie 1982
  10. 100  'NOTE that program performs a GET function, moving figure into array FIGURE%
  11. 110  'PUT function is used to plot it somewhere
  12. 120  OPTION BASE 0:KEY OFF:SCREEN 1:COLOR 0,7:DEFINT A-Z
  13. 130  FOR I=1 TO 10:KEY I,"":NEXT I
  14. 140  DIM F(1350):WINDX1=240:WINDY1=120
  15. 150  CLS:PRINT TAB(15);"DEFINE"
  16. 160  PRINT TAB(8);"(c) Bruce Guthrie 1982"
  17. 170  INPUT "Need instructions [Y/N]? ",A$:IF A$="n" OR A$="N" THEN 210:ELSE IF A$<>"y" AND A$<>"Y" THEN 170
  18. 180  OPEN "DEFINE.INS" FOR INPUT AS #1:I=0:WIDTH 80
  19. 190  I=I+1:IF EOF(1) THEN INPUT "Press RETURN? ",A$:WIDTH 40:GOTO 210
  20. 200  INPUT #1,A$:PRINT A$:IF I<22 THEN 190:ELSE I=0:INPUT "Press RETURN? ",A$:GOTO 190
  21. 210  CLS:PRINT "Is file stored already [Y/N] caps only ? ";:STORED$="N"
  22. 220  A$=INKEY$:IF A$<>"Y" AND A$<>"N" THEN 220:ELSE PRINT A$:IF A$="N" THEN CLS:GOTO 250
  23. 230  STORED$="Y":INPUT "File name to load? ",A$:INPUT "Storage device [A/B]? ",B$:IF B$<>"A" AND B$<>"B" THEN 230
  24. 240  CLS:CHAIN MERGE B$+":"+A$+".PLT",30,ALL
  25. 250  FOR I=1 TO 21:LOCATE I,1:PRINT".....................";:NEXT I
  26. 260  FOR I=1 TO 21 STEP 5:LOCATE I,1:PRINT"---------------------";:NEXT I
  27. 270  FOR I=1 TO 21:FOR J=1 TO 21 STEP 5:LOCATE I,J:PRINT "|";:NEXT J,I
  28. 280  LINE(199,79)-(301,181),,B:FOR I=200 TO 300 STEP 20:LINE(I,75)-STEP(0,4):LINE(I,181)-STEP(0,4):NEXT I:FOR I=80 TO 180 STEP 20:LINE(195,I)-STEP(4,0):LINE(301,I)-STEP(4,0):NEXT I:C=3:GOSUB 550
  29. 290  GOSUB 640:PRINT "Checking grid."
  30. 300  A$="@":FOR X=WINDX1 TO WINDX2:FOR Y=WINDY1 TO WINDY2:IF POINT(X,Y)=3 THEN GOSUB 650
  31. 310  NEXT Y,X:GOSUB 640
  32. 320  X=WINDX1+10:Y=WINDY1+10:GOSUB 660:PREVX=X1:PREVY=X1:LET A$=CHR$(SCREEN(Y1,X1))
  33. 330  LOCATE 2,25:PRINT "USE DIREC-":LOCATE 3,25:PRINT "TION KEYS":LOCATE 4,25:PRINT "TO POSITION,":LOCATE 5,25:PRINT "PF'S TO USE.":LOCATE 6,25:PRINT "PF 1=CHOOSE/":LOCATE 7,25:PRINT " DE-CHOOSE":LOCATE 8,25:PRINT "PF 2=MEMORIZE IT"
  34. 340  REM START OF LOOP FOR MOVEMENT
  35. 350  LOCATE Y1,X1:PRINT " ";:LOCATE Y1,X1:PRINT A$;:X$=INKEY$:IF LEN(X$)<>2 THEN 350:ELSE IN=ASC(MID$(X$,2,1))
  36. 360  IF IN=59 GOTO 370 ELSE IF IN=60 GOTO 410 ELSE IF IN=72 GOTO 560 ELSE IF IN=75 GOTO 580 ELSE IF IN=77 GOTO 600 ELSE IF IN=80 GOTO 620:ELSE GOTO 350
  37. 370  IF POINT(X,Y)=3 THEN PRESET(X,Y):LOCATE Y1,X1:PRINT ".";:GOTO 390:ELSE PSET(X,Y)
  38. 380  LOCATE PREVY,PREVX:PRINT A$;
  39. 390  CHAR=SCREEN(Y1,X1):IF POINT(X,Y)=0 THEN LET A$=CHR$(CHAR) ELSE LET A$="@"
  40. 400  PREVX=X1:PREVY=Y1:GOSUB 660:GOTO 350
  41. 410  REM FIGURE DEFINED, ALLOWED NEW FOCUS OR NOT
  42. 420  GOSUB 640:PRINT "Define another":PRINT "window [Y/N]? ";
  43. 430  A$=INKEY$:IF A$="" THEN 430:ELSE PRINT A$:LET A$=MID$(A$,1,1):IF A$="y" THEN A$="Y" ELSE IF A$="n" THEN A$="N"
  44. 440  IF A$="N" THEN 670:ELSE IF A$<>"Y" THEN 420:ELSE GOSUB 640:PRINT "Cursor controls move.":PRINT "Use PF 2 to accept.";
  45. 450  X$=INKEY$:IF LEN(X$)<>2 THEN 450:ELSE IN=ASC(MID$(X$,2,1))
  46. 460  IF IN=60 THEN GOSUB 640:GOTO 250:ELSE C=0:GOSUB 550:IF IN=72 GOTO 470:ELSE IF IN=75 GOTO 490:ELSE IF IN=77 GOTO 510:ELSE IF IN=80 GOTO 530:ELSE GOTO 540
  47. 470  WINDY1=WINDY1-20:IF WINDY1<80 THEN WINDY1=80
  48. 480  GOTO 540
  49. 490  WINDX1=WINDX1-20:IF WINDX1<200 THEN WINDX1=200
  50. 500  GOTO 540
  51. 510  WINDX1=WINDX1+20:IF WINDX1>280 THEN WINDX1=280
  52. 520  GOTO 540
  53. 530  WINDY1=WINDY1+20:IF WINDY1>160 THEN WINDY1=160
  54. 540  C=3:GOSUB 550:GOTO 450
  55. 550  WINDX2=WINDX1+20:WINDY2=WINDY1+20:LINE(195,WINDY1)-(195,WINDY2),C:LINE(WINDX1,75)-(WINDX2,75),C:RETURN
  56. 560  Y1=Y1-1:IF Y1=0 THEN Y1=1
  57. 570  GOTO 630
  58. 580  X1=X1-1:IF X1=0 THEN X1=1
  59. 590  GOTO 630
  60. 600  X1=X1+1:IF X1=22 THEN X1=21
  61. 610  GOTO 630
  62. 620  Y1=Y1+1:IF Y1=22 THEN Y1=21
  63. 630  X=WINDX1+X1-1:Y=WINDY1+Y1-1:GOTO 380
  64. 640  FOR I=22 TO 24:LOCATE I,1:PRINT SPACE$(21);:NEXT I:LOCATE 22,1:RETURN
  65. 650  LOCATE Y-WINDY1+1,X-WINDX1+1:PRINT A$;:RETURN
  66. 660  X1=X-WINDX1+1:Y1=Y-WINDY1+1:RETURN
  67. 670  GOSUB 640:PRINT "Done";:LOCATE 1,1:PRINT SPACE$(160):LOCATE 1,1:PRINT "Use cursor keys to set area to be":PRINT "read.  Use 1, 3, 7, and 9 to show ":PRINT "which edge is being worked on.":PRINT "Use PF 2 to set."
  68. 680  XMIN=199:XMAX=301:YMIN=79:YMAX=181:CX=1:CY=1:GET(200,80)-(300,180),F
  69. 690  A$=INKEY$:IF A$="" THEN 690:ELSE IF LEN(A$)<2 THEN 690
  70. 700  A=ASC(MID$(A$,2,1)):IF A=60 THEN 760:ELSE IF A=71 THEN CX=1:CY=1:GOTO 690:ELSE IF A=73 THEN CX=2:CY=1:GOTO 690:ELSE IF A=79 THEN CX=1:CY=2:GOTO 690:ELSE IF A=81 THEN CX=2:CY=2:GOTO 690
  71. 710  IF A=72 THEN:IF CY=1 THEN YMIN=YMIN-1:GOTO 750:ELSE YMAX=YMAX-1:GOTO 750
  72. 720  IF A=75 THEN:IF CX=1 THEN XMIN=XMIN-1:GOTO 750:ELSE XMAX=XMAX-1:GOTO 750
  73. 730  IF A=77 THEN:IF CX=1 THEN XMIN=XMIN+1:GOTO 750:ELSE XMAX=XMAX+1:GOTO 750
  74. 740  IF A<>80 THEN 690:ELSE IF CY=1 THEN YMIN=YMIN+1:GOTO 750:ELSE YMAX=YMAX+1
  75. 750  PUT(200,80),F,PSET:LINE(XMIN,YMIN)-(XMAX,YMAX),1,B:LINE(XMIN-1,YMIN-1)-(XMAX+1,YMAX+1),1,B:GOTO 690
  76. 760  GET(XMIN+1,YMIN+1)-(XMAX-1,YMAX-1),F
  77. 770  CLS:PRINT "This figure is defined for you:":PUT (100,20),F:LOCATE 21,1:FOR I=1 TO 1000:NEXT I
  78. 780  CLS:PRINT "Store at DATA statements for ":INPUT "BASIC program [Y/N]? ",A$:A$=MID$(A$,1,1):IF A$="n" THEN A$="N":ELSE IF A$="y" THEN A$="Y"
  79. 790  IF A$="N" THEN 930
  80. 800  INPUT "File name to save under? ",A$
  81. 810  IF INSTR(A$,".") >0 THEN PRINT "File extension ignored.":PRINT "`PLT' assigned.":A$=MID$(A$,1,INSTR(A$,',')-1)
  82. 820  A$=A$+".PLT":IF INSTR(A$,":")=2 THEN A$=MID$(A$,3)
  83. 830  INPUT"Storage device [A/B]? ",B$:IF B$<>"A" AND B$<>"B" THEN 830
  84. 840  PRINT "Storing file..."
  85. 850  A$=B$+":"+A$:CLOSE:OPEN A$ FOR OUTPUT AS #1:LS=4+INT(((XMAX-XMIN-1)*2+7)/8)*(YMAX-YMIN-1):LS=INT((LS+1)/2):I=0
  86. 860  PRINT #1,50000+I;" DATA ";F(I);",";F(I+1);",";F(I+2);",";F(I+3);",";F(I+4);",";F(I+5);",";F(I+6);",";F(I+7);",";F(I+8);",";F(I+9):I=I+10:IF I<LS THEN 860
  87. 870  PRINT #1,"50135 DIM FI%(";LS-1;"):RESTORE 50000:FOR I=0 TO ";LS-1;":READ FI%(I):NEXT I:RETURN"
  88. 880  CLOSE
  89. 890  PRINT "DATA statements are stored as lines":PRINT "50000-50135.":PRINT "You can add it to a program":PRINT "by CHAIN MERGE ";A$
  90. 900  PRINT "Print figure via PUT(),FI% graphics ":PRINT "statement."
  91. 910  FOR I=1 TO 1000:NEXT I
  92. 920  PRINT "File created for you.":FILES B$+":*.plt"
  93. 930  END
  94.